home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2004 #2 / Amiga Plus CD - 2004 - No. 02.iso / AmigaPlus / Tools / Development / AmigaTalk / system / AmigaGuide.st next >
Encoding:
Text File  |  2004-01-31  |  12.1 KB  |  337 lines
  1. " ------------------------------------------------------------------------- "
  2. " AmigaGuide Class implements the Amigatalk interface to amigaguide.library "
  3. " This Class is only one step removed from primitives, so use it to derive  "
  4. " a Class that is really Object-Oriented! "
  5. " ------------------------------------------------------------------------- "
  6.  
  7. Class AmigaGuide :Object ! private private2 private3 !
  8. [
  9.    addAmigaGuideHost: hostNameString hook: hookObj tags: tagArray
  10.      " Returns nil if unable to add the AmigaGuide Host named: "
  11.      private2 <- <primitive 209 2 2 hookObj hostNameString tagArray>
  12. |
  13.    removeAmigaGuideHost: tagArray " tagArray should be nil for now. "
  14.      (private2 isNotNil)
  15.         ifTrue: [^ <primitive 209 2 3 private2 tagArray>]
  16. |
  17.    getAmigaGuideSignal
  18.      ^ <primitive 209 2 4 private>
  19. |
  20.    closeAmigaGuide
  21.  
  22.      <primitive 209 2 0 private>.
  23.      
  24.      <primitive 250 5 0 private>.
  25.      
  26.      ^ nil
  27. |
  28.    getAmigaGuideAttribute: attrTag into: storageObj
  29.      " For attrTag, see AGuideTags Class below "
  30.      ^ <primitive 209 2 5 attrTag private storageObj>
  31. |
  32.    getAmigaGuideMsg
  33.      " Returns nil if there was no message: "
  34.      ^ <primitive 209 2 6 private>
  35. |
  36.    getAGMsgType: aGuideMsgObj
  37.      " aGuideMsgObj is from getAmigaGuideMsg method: "
  38.      ^ <primitive 209 2 31 aGuideMsgObj>
  39. |
  40.    getAGMsgData: aGuideMsgObj
  41.      " aGuideMsgObj is from getAmigaGuideMsg method: "
  42.      ^ <primitive 209 2 32 aGuideMsgObj>
  43. |
  44.    getAGMsgDataType: aGuideMsgObj
  45.      " aGuideMsgObj is from getAmigaGuideMsg method: "
  46.      ^ <primitive 209 2 33 aGuideMsgObj>
  47. |
  48.    getAGMsgDataSize: aGuideMsgObj
  49.      " aGuideMsgObj is from getAmigaGuideMsg method: "
  50.      ^ <primitive 209 2 34 aGuideMsgObj>
  51. |
  52.    getAGMsgReturnPrimaryValue: aGuideMsgObj
  53.      " aGuideMsgObj is from getAmigaGuideMsg method: "
  54.      ^ <primitive 209 2 35 aGuideMsgObj>
  55. |
  56.    getAGMsgReturnSecondaryValue: aGuideMsgObj
  57.      " aGuideMsgObj is from getAmigaGuideMsg method: "
  58.      ^ <primitive 209 2 36 aGuideMsgObj>
  59. |
  60.    getAmigaGuideString: stringIDNumber
  61.      " Returns a String Object or nil: "
  62.      ^ <primitive 209 2 7 stringIDNumber>
  63. |
  64.    lockAmigaGuideBase                        " You DO NOT need to use this method!! "
  65.      " Returns a key for unlockAmigaGuideBase: "
  66.      ^ <primitive 209 2 8 private>
  67. |
  68.    unlockAmigaGuideBase: keyFromLockMethod   " You DO NOT need to use this method!! "
  69.      <primitive 209 2 9 keyFromLockMethod>
  70. |
  71.    openAmigaGuide: tagArray
  72.      " For valid tags, see AGuideTags Class below "
  73.      ^ private <- <primitive 209 2 1 private3 tagArray>
  74. |
  75.    openAmigaGuideASync: tagArray
  76.      " For valid tags, see AGuideTags Class below "
  77.      ^ private <- <primitive 209 2 10 private3 tagArray>
  78. |
  79.    replyAmigaGuideMsg: amigaGuideMsgObj
  80.      " Reply to the msg Object obtained from the getAmigaGuideMsg method: "
  81.      <primitive 209 2 11 amigaGuideMsgObj>
  82. |
  83.    sendAmigaGuideCommand: commandString tags: tagArray " tagArray should be nil for now. "
  84.      " The following are the currently valid action commands:
  85.      *
  86.      *   ALINK <name> - Load the named node into a new window.
  87.      *
  88.      *   LINK <name>  - Load the named node.
  89.      *
  90.      *   RX <macro>   - Execute an ARexx macro.
  91.      *
  92.      *   RXS <cmd> - Execute an ARexx string file.  To display a picture,
  93.      *               use 'ADDRESS COMMAND DISPLAY <picture name>', to
  94.      *               display a text file 'ADDRESS COMMAND MORE <doc>'.
  95.      *
  96.      *   CLOSE - Close the window (should only be used on windows
  97.      *           that were started with ALINK).
  98.      *
  99.      *   QUIT  - Shutdown the current database.
  100.      *
  101.      *   This method returns true if the message was sent:
  102.      "
  103.      ^ <primitive 209 2 12 private commandString tagArray>
  104. |
  105.    sendAmigaGuideContext: tagArray " tagArray should be nil for now. "
  106.      ^ <primitive 209 2 13 private tagArray> 
  107. |
  108.    setAmigaGuideAttributes: tagArray
  109.      " For valid tags, see AGuideTags Class below "
  110.      ^ <primitive 209 2 14 private tagArray>
  111. |
  112.    setAmigaGuideContext: idNumber tags: tagArray " tagArray should be nil for now. "
  113.      ^ <primitive 209 2 15 private idNumber tagArray>
  114. |
  115.    loadCrossReferencesFrom: fileName in: directoryLock
  116.      " Returns an integer with the following meanings:
  117.      *
  118.      *    -1 - indicates that the load was aborted by CTRL-C from the User.
  119.      *     0 - indicates failure to load.
  120.      *     1 - indicates a successful load.
  121.      *     2 - indicates that the table is already loaded.
  122.      "
  123.      ^ <primitive 209 2 18 directoryLock fileName>
  124. |
  125.    expungeCrossReferences " Unload the cross-reference table from memory. "
  126.      <primitive 209 2 19> 
  127. |
  128.    createNewAmigaGuideObject
  129.      ^ private3 <- <primitive 209 0 1 250>  " STRUCT_NewAmigaGuide = 250 "
  130. |
  131.    disposeNAG
  132.  
  133.      <primitive 209 0 2 private3>.
  134.      
  135.      <primitive 250 5 0 private3>.
  136.  
  137.      ^ nil 
  138. |
  139.    setNAGDirectoryLock: directoryLock
  140.      <primitive 209 2 20 private3 directoryLock>     
  141. |
  142.    setNAGName: databaseName
  143.      <primitive 209 2 21 private3 databaseName>     
  144. |
  145.    setNAGScreen: screenObject
  146.      <primitive 209 2 22 private3 screenObject>
  147. |
  148.    setNAGPulicScreen: publicScreenName
  149.      <primitive 209 2 23 private3 publicScreenName>     
  150. |
  151.    setNAGARexxClientPort: clientPortName
  152.      <primitive 209 2 24 private3 clientPortName>
  153. |
  154.    setNAGFlags: newFlags
  155.      " Valid values for newFlags is any of the following:
  156.      *    HTF_LOAD_INDEX
  157.      *    This flag only applies to an ansynchronous open.
  158.      *    Force the index of the database to always be
  159.      *    loaded.  The AmigaGuide system maintains two date
  160.      *    stamps, one for the last time that the database was
  161.      *    opened and the other for the last time that the
  162.      *    database was accessed by the user. The hyper system
  163.      *    makes several calculations based on the current
  164.      *    date stamp and the other two date stamps to
  165.      *    determine what portions of the database need to be pre-cached.
  166.      *
  167.      *    HTF_LOAD_ALL
  168.      *    Load the entire database, and all its nodes into memory.
  169.      *
  170.      *    HTF_CACHE_NODE
  171.      *    Don't flush a node from memory after the user is finished viewing it.
  172.      *
  173.      *    HTF_CACHE_DB
  174.      *    Don't remove buffers when closed.  This will cause
  175.      *    the buffers to remain until the library is expunged.
  176.      " 
  177.      <primitive 209 2 25 private3 newFlags>     
  178. |
  179.    setNAGContextStrings: nodeStringsArray " Last element of Array MUST be nil! "
  180.      <primitive 209 2 26 private3 nodeStringsArray>     
  181. |
  182.    disposeContext 
  183.      " Use this after all 'setNAGContextStrings:' have been done (unless
  184.      * you have memory to burn!)
  185.      "
  186.      <primitive 209 2 30 private3>
  187. |
  188.    setNAGStartNode: nodeName
  189.      <primitive 209 2 27 private3 nodeName>
  190. |
  191.    setNAGStartLine: lineNumber
  192.      <primitive 209 2 28 private3 lineNumber>     
  193. |
  194.    setNAGTags: tagArray
  195.      " For valid tags, see AGuideTags Class below "
  196.      <primitive 209 2 29 private3 tagArray>     
  197. |
  198.    setNAGBaseName: appBaseName        " appBaseName can be nil "
  199.      <primitive 209 2 37 appBaseName>
  200. ]
  201.  
  202. " ------------------------------------------------------------------- "
  203. " AGuideTags Class is a Singleton class that allows the user to       "
  204. " reference special AmigaGuide Flags & Tags as #Symbols.              "
  205. ""
  206. " ALL singleton classes MUST contain the following:                   "
  207. ""
  208. "   the methods:  isSingleton AND privateSetup     AND                "
  209. "                 uniqueInstance Class instance variable.             "
  210. " ------------------------------------------------------------------- "
  211.  
  212. Class AGuideTags :Dictionary ! uniqueInstance !
  213. [
  214.    isSingleton
  215.      ^ true
  216. |
  217.    privateNew ! newinstance !
  218.      newinstance <- super new.
  219.  
  220.      ^ newinstance
  221. |
  222.    new
  223.      ^ self privateSetup
  224. |
  225.    privateInitializeDictionary
  226.  
  227.      self at: #StartupMsgID     put: 16r11001.  " Startup message         "
  228.      self at: #LoginToolID      put: 16r11002.  " Login a tool SIPC port  "
  229.      self at: #LogoutToolID     put: 16r11003.  " Logout a tool SIPC port "
  230.  
  231.      self at: #ShutdownMsgID    put: 16r11004.  " Shutdown message      "
  232.      self at: #ActivateToolID   put: 16r11005.  " Activate tool         "
  233.      self at: #DeactivateToolID put: 16r11006.  " Deactivate tool       "
  234.      self at: #ActiveToolID     put: 16r11007.  " Tool Active           "
  235.      self at: #InactiveToolID   put: 16r11008.  " Tool Inactive         "
  236.      self at: #ToolStatusID     put: 16r11009.  " Status message        "
  237.      self at: #ToolCmdID        put: 16r1100A.  " Tool command message  "
  238.      self at: #ToolCmdReplyID   put: 16r1100B.  " Reply to tool command "
  239.      self at: #ShutdownToolID   put: 16r1100C.  " Shutdown tool         "
  240.  
  241.      " Attributes accepted by getAmigaGuideAttribute:into: "
  242.  
  243.      self at: #AGA_Path         put: 16r80000001.
  244.      self at: #AGA_XRefList     put: 16r80000002.
  245.      self at: #AGA_Activate     put: 16r80000003.
  246.      self at: #AGA_Context      put: 16r80000004.
  247.      self at: #AGA_HelpGroup    put: 16r80000005. " Unique Integer identifier "
  248.      self at: #AGA_Reserved1    put: 16r80000006.
  249.      self at: #AGA_Reserved2    put: 16r80000007.
  250.      self at: #AGA_Reserved3    put: 16r80000008.
  251.  
  252.      " msgPortObject that is an ARexx message port: "
  253.  
  254.      self at: #AGA_ARexxPort     put: 16r80000009.
  255.  
  256.      " String used to specify the ARexx port name (not copied): "
  257.  
  258.      self at: #AGA_ARexxPortName put: 16r8000000A.
  259.  
  260.      self at: #AGA_Secure        put: 16r8000000B.
  261.  
  262.      " public Client flags (For setNAGFlags: method): "
  263.  
  264.      self at: #HTF_LOAD_INDEX  put: 1.  " Force load the index at init time "
  265.      self at: #HTF_LOAD_ALL    put: 2.  " Force load the entire database at init "
  266.      self at: #HTF_CACHE_NODE  put: 4.  " Cache each node as visited "
  267.      self at: #HTF_CACHE_DB    put: 8.  " Keep the buffers around until expunge "
  268.  
  269.      self at: #HTF_UNIQUE      put: 16r8000.  " Unique ARexx port name "
  270.      self at: #HTF_NOACTIVATE  put: 16r10000. " Don't activate window  "
  271.  
  272.      self at: #HTFC_SYSGADS    put: 16r80000000.
  273.  
  274.      " Callback function ID's "
  275.  
  276.      self at: #HTH_OPEN        put: 0.
  277.      self at: #HTH_CLOSE       put: 1.
  278.  
  279.      " Error message numbers: "
  280.  
  281.      self at: #HTERR_NOT_ENOUGH_MEMORY  put: 100.
  282.      self at: #HTERR_CANT_OPEN_DATABASE put: 101.
  283.      self at: #HTERR_CANT_FIND_NODE     put: 102.
  284.      self at: #HTERR_CANT_OPEN_NODE     put: 103.
  285.      self at: #HTERR_CANT_OPEN_WINDOW   put: 104.
  286.      self at: #HTERR_INVALID_COMMAND    put: 105.
  287.      self at: #HTERR_CANT_COMPLETE      put: 106.
  288.      self at: #HTERR_PORT_CLOSED        put: 107.
  289.      self at: #HTERR_CANT_CREATE_PORT   put: 108.
  290.      self at: #HTERR_KEYWORD_NOT_FOUND  put: 113.
  291.  
  292.      " Methods "
  293.  
  294.      self at: #HM_FINDNODE    put: 1.  " opFindHost "
  295.      self at: #HM_OPENNODE    put: 2.  " opNodeIO "
  296.      self at: #HM_CLOSENODE   put: 3.  " opNodeIO "
  297.      self at: #HM_EXPUNGE     put: 10. " Expunge DataBase  (opExpungeNode) "
  298.  
  299.      " onm_Flags (opNodeIO) "
  300.  
  301.      self at: #HTNF_KEEP      put: 1.  " Don't flush this node until database is closed "
  302.      self at: #HTNF_RESERVED1 put: 2.  " Reserved for system use "
  303.      self at: #HTNF_RESERVED2 put: 4.  " Reserved for system use "
  304.      self at: #HTNF_ASCII     put: 8.  " Node is straight ASCII "
  305.      self at: #HTNF_RESERVED3 put: 16. " Reserved for system use "
  306.      self at: #HTNF_CLEAN     put: 32. " Remove the node from the database "
  307.      self at: #HTNF_DONE      put: 64. " Done with node "
  308.  
  309.      " onm_Attrs (opNodeIO) "
  310.  
  311.      self at: #HTNA_Screen    put: 16r80000001. " screenObject that window resides in "
  312.      self at: #HTNA_Pens      put: 16r80000002. " Pen array (from DrawInfo) "
  313.      self at: #HTNA_Rectangle put: 16r80000003. " Window box                "
  314.      self at: #HTNA_HelpGroup put: 16r80000005. " unique Integer identifier "
  315.  
  316.      " Types of cross reference nodes "
  317.  
  318.      self at: #XR_GENERIC     put: 0.
  319.      self at: #XR_FUNCTION    put: 1.
  320.      self at: #XR_COMMAND     put: 2.
  321.      self at: #XR_INCLUDE     put: 3.
  322.      self at: #XR_MACRO       put: 4.
  323.      self at: #XR_STRUCT      put: 5.
  324.      self at: #XR_FIELD       put: 6.
  325.      self at: #XR_TYPEDEF     put: 7.
  326.      self at: #XR_DEFINE      put: 8.
  327. |
  328.    privateSetup
  329.      (uniqueInstance isNil)
  330.        ifTrue: [uniqueInstance <- self privateNew.
  331.  
  332.                 self privateInitializeDictionary
  333.                ].
  334.                
  335.      ^ self    "or ^ uniqueInstance??"
  336. ]
  337.